home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS19.ADF
/
HouseHold
/
HouseInvMaint
< prev
next >
Wrap
Text File
|
1989-01-27
|
11KB
|
420 lines
' The Household Inventory File Maintenance Program
' ------------------------------------------------
' This is Program #3 of 3: :"HouseInvMaint" -file maintenance
' Program #1 is the "HouseInv" (main) program
' Program #2 is the "HouseInvPrint" program
'
' Please do not modify the title screen in any way.
' January 1987
'
numbx=4:RecCnt=0:NewCnt=0:m=0:i=0:ErrSw=0:type=0
A%=0:B%=0
DIM bx(numbx-1,6),bxtxt$(numbx-1)
Logo80 3
BldGadgets numbx,bx(),bxtxt$()
' No and OK Gadgets
DATA 28, 36,24,16,7,4,0,"No"
DATA 116, 36,24,16,7,2,0,"Ok"
' Help Gadgets
DATA 36,172,40,16,7,4,0,"More"
DATA 156,172,40,16,7,2,0," Ok"
InA%=0:InB%=1
HlpA%=2:HlpB%=3
COLOR Blu,Blk
LOCATE 9,39:PRINT"THE"
LOCATE 11,22:PRINT"H O U S E H O L D I N V E N T O R Y"
LOCATE 13,38:PRINT"SYSTEM"
COLOR Mag,Blk
LOCATE 16,25:PRINT"F I L E M A I N T E N A N C E"
MENU 1,0,1,"Project:"
MENU 1,1,1,"Quit "
MENU 2,0,1,"Help:"
MENU 2,1,1,"General "
MENU 2,2,1,"Initialize "
MENU 2,3,1,"Reorganize "
MENU 2,4,1,"Record Count"
MENU 2,5,1,"Update Count"
MENU 3,0,1,"Maintenance:"
MENU 3,1,1,"Initialize "
MENU 3,2,1,"Reorganize "
MENU 3,3,1,"Record Count"
MENU 3,4,1,"Update Count"
MENU 4,0,0,""
ON ERROR GOTO InitError
ErrSw=0:GOSUB GetRecCnt
InitCont:
ON ERROR GOTO 0
IF ErrSw=1 THEN ErrSw=0:RecCnt=0:GOSUB PutRecCnt
ON MOUSE GOSUB GetMouse
ON MENU GOSUB GetMenu
COLOR Yel,Blk:LOCATE 21,23
PRINT"Use Menus to select program function"
WaitHere:
MENU ON:m=0:i=0:WHILE m=0:SLEEP:WEND
MENU OFF:ON m GOTO Quit,Help,Maintain
' Count File Error Routine
' ------------------------
InitError:
WINDOW 2
IF ERR=53 THEN
ErrSw=1:RESUME InitCont
ELSE
ON ERROR GOTO 0
END IF
' Menu Event Routine
' ------------------
GetMenu:
m=MENU(0):i=MENU(1)
RETURN
' Mouse Event Routine
' -------------------
GetMouse:
GetGadget A%,B%,bx(),bxtxt$(),type
RETURN
' Wait for Mouse Click
' --------------------
WaitMouse:
MOUSE ON
type=0:WHILE type=0:SLEEP:WEND
MOUSE OFF
RETURN
' Open Main Data File
' -------------------
Opendata:
IF RecCnt=0 THEN
WINDOW 3,,(440,40)-(608,96),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"File is empty."
DrawGadgets InB%,InB%,bx(),bxtxt$()
A%=InB%:B%=InB%:GOSUB WaitMouse
ErrSw=1:WINDOW CLOSE 3
GOTO ODXit
END IF
OPEN "R",#1,"HouseInv.Data",103
FIELD #1,1 AS d1$,10 AS d2$,15 AS d3$,8 AS d4$,6 AS d5$,6 AS d6$,6 AS d7$,15 AS d8$,20 AS d9$,8 AS d10$,8 AS d11$
ErrSw=0
ODXit:
RETURN
' Open Temporary Data File
' ------------------------
OpenTemp:
OPEN "R",#9,"Temp.Data",103
FIELD #9,1 AS t1$,10 AS t2$,15 AS t3$,8 AS t4$,6 AS t5$,6 AS t6$,6 AS t7$,15 AS t8$,20 AS t9$,8 AS t10$,8 AS t11$
RETURN
' Get Record Count
' ----------------
GetRecCnt:
OPEN"HouseInv.Count" FOR INPUT AS #2
INPUT #2,RecCnt
CLOSE #2
RETURN
' Update Record Count
' -------------------
PutRecCnt:
WINDOW 3,,(440,40)-(608,96),0,1
COLOR Blu,Yel:CLS
LOCATE 2,4:PRINT"Updating Count"
LOCATE 3,4:PRINT"File."
OPEN"HouseInv.Count" FOR OUTPUT AS #2
WRITE #2,RecCnt
CLOSE #2
WINDOW CLOSE 3
RETURN
' Time to Quit and Return to Basic
' --------------------------------
Quit:
MENU RESET
WINDOW CLOSE 2:SCREEN CLOSE 1
END
' Help Routines
' -------------
Help:
GOSUB DoHelp
GOTO WaitHere
' Data File Maintenance Routines
' ------------------------------
Maintain:
ON i GOTO MInit,MReorg,MRecCount,MUpdCount
' Initialize the Count File to Zero
MInit:
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"This option will"
LOCATE 3,3:PRINT"delete any records"
LOCATE 4,3:PRINT"on file."
DrawGadgets InA%,InB%,bx(),bxtxt$()
A%=InA%:B%=InB%:GOSUB WaitMouse
WINDOW CLOSE 3
ON type GOTO MInXit,MInOK
MInOK:
IF RecCnt>0 THEN
KILL"houseInv.Data":KILL"HouseInv.Data.info"
END IF
RecCnt=0:GOSUB PutRecCnt
MInXit:
GOTO MaintXit
' Reorganize the Data File
MReorg:
GOSUB Opendata:IF ErrSw=1 THEN MRXit
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"Reorganizing the"
LOCATE 3,3:PRINT"Data File."
GOSUB OpenTemp:NewCount=0
FOR n=1 TO RecCnt
GET #1,n
IF d1$="0" THEN
NewCnt=NewCnt+1
LSET t1$=d1$:LSET t2$=d2$:LSET t3$=d3$:LSET t4$=d4$
LSET t5$=d5$:LSET t6$=d6$:LSET t7$=d7$:LSET t8$=d8$
LSET t9$=d9$:LSET t10$=d10$:LSET t11$=d11$
PUT #9,NewCnt
END IF
NEXT
CLOSE #1:CLOSE #9
KILL"HouseInv.Data.info":KILL"HouseInv.Data"
NAME"Temp.Data.info" AS "HouseInv.Data.info"
NAME"Temp.Data" AS "HouseInv.Data"
WINDOW CLOSE 3
RecCnt=NewCnt:GOSUB PutRecCnt
MRXit:
GOTO MaintXit
' Show Count of Records on File
MRecCount:
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,4:PRINT"Record Count"
LOCATE 4,2:PRINT USING"Commited: #####";RecCnt
DrawGadgets InB%,InB%,bx(),bxtxt$()
A%=InB%:B%=InB%:GOSUB WaitMouse
WINDOW CLOSE 3
GOTO MaintXit
' Update Count File to Match Data File
MUpdCount:
GOSUB Opendata:IF ErrSw=1 THEN UCXit
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"Counting..."
n=1
UCGet:
GET #1,n
IF EOF(1) THEN UCDone
n=n+1:GOTO UCGet
UCDone:
WINDOW CLOSE 3
RecCount=n-1:GOSUB PutRecCnt
UCXit:
GOTO MaintXit
MaintXit:
GOTO WaitHere
' Help Routines (requested via Help Menu)
' ---------------------------------------
DoHelp:
WINDOW 4,,(408,0)-(631,186),0,1
COLOR Blu,Yel:CLS:LOCATE 2,1
ON i GOTO HlpGen,HlpInit,HlpReorg,HlpRecCnt,HlpUpdCnt
HlpGen:
PRINT" 'HouseInvMaint' performs"
PRINT" the necessary maintenance"
PRINT" functions on the data"
PRINT" file created by"
PRINT" 'HouseInv'. It is not"
PRINT" concerned with the"
PRINT" contents of the file, but"
PRINT" rather with the file"
PRINT" itself.":PRINT" "
PRINT" A third program,"
PRINT" 'HouseInvPrint' is used"
PRINT" to print reports based on"
PRINT" the contents of the data"
PRINT" file."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpInit:
PRINT" This function, available"
PRINT" in this and the main pro-"
PRINT" gram, allows you to start"
PRINT" from scratch.":PRINT" "
PRINT" The main data file is a"
PRINT" random access file with a"
PRINT" 'count' file being used"
PRINT" to keep track of the num-"
PRINT" ber of data records.":PRINT" "
PRINT" 'Initialize' causes the"
PRINT" data file to be deleted"
PRINT" and the count file to be"
PRINT" reset to zero.":PRINT" "
PRINT" It should be the first"
PRINT" function used."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpReorg:
PRINT" When records are deleted"
PRINT" they remain in the data"
PRINT" file with a 'deleted'"
PRINT" flag turned on. When"
PRINT" 'reviewed' they show up"
PRINT" with '*' field separators"
PRINT" and may be restored by"
PRINT" selecting them.":PRINT" "
PRINT" 'Reorganize' copies the"
PRINT" data file dropping all"
PRINT" deleted records. There-"
PRINT" fore, after reorganiza-"
PRINT" tion, any previously del-"
PRINT" eted records are gone"
PRINT" forever."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpRecCnt:
PRINT" 'Record Count' provides"
PRINT" you with a count of the"
PRINT" number of records pres-"
PRINT" ently in the data file."
PRINT" The count will include"
PRINT" any records that may have"
PRINT" been previously deleted"
PRINT" if the file has not been"
PRINT" reorganized."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpUpdCnt:
PRINT" 'Update Count' counts the"
PRINT" number of records in the"
PRINT" data file, and updates or"
PRINT" creates the count file"
PRINT" with that number.":PRINT" "
PRINT" Should be used only if"
PRINT" the count file is "
PRINT" deleted or becomes"
PRINT" unreadable."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpXit:
WINDOW CLOSE 4
RETURN
' Various Subprograms
' -------------------
SUB Logo80 (Depth%) STATIC
SHARED Blk,Blu,Grn,Cyn,Red,Mag,Yel,Wht
IF First=0 THEN
First=1
SCREEN 1,640,200,Depth%,2
WINDOW 2,,,16,1
COLOR ,0:CLS
PALETTE 0,0,0,0 :Blk=0:'Black
PALETTE 1,0,0,1 :Blu=1:'Blue
PALETTE 2,0,.75,0:Grn=2:'Green
PALETTE 3,0,1,1 :Cyn=3:'Cyan
PALETTE 4,1,0,0 :Red=4:'Red
PALETTE 5,1,0,1 :Mag=5:'Magenta
PALETTE 6,1,.8,0 :Yel=6:'Yellow
PALETTE 7,1,1,1 :Wht=7:'White
END IF
COLOR ,Blk:CLS
AREA(376,8):AREA STEP(64,0):AREA STEP(-20,16)
AREA STEP(0,24):AREA STEP(-24,0):AREA STEP(0,-24)
COLOR Blu:AREAFILL
AREA(360,8):AREA STEP(32,0):AREA STEP(0,12)
AREA STEP(-16,0):AREA STEP(0,4):AREA STEP(8,0):AREA STEP(0,8)
AREA STEP(-8,0):AREA STEP(0,4):AREA STEP(24,0):AREA STEP(0,12)
AREA STEP(-40,0):COLOR Grn:AREAFILL
AREA(328,8):AREA STEP(24,0):AREA STEP(0,28)
AREA STEP(24,0):AREA STEP(0,12):AREA STEP(-48,0)
COLOR Red:AREAFILL
AREA(272,8):AREA STEP(64,0):AREA STEP(0,12)
AREA STEP(-20,0):AREA STEP(0,28):AREA STEP(-24,0):AREA STEP(0,-28)
AREA STEP(-20,0):COLOR Cyn:AREAFILL
AREA(264,8):AREA STEP(16,0):AREA STEP(24,40)
AREA STEP(-16,0):AREA STEP(-8,-12):AREA STEP(-16,0):AREA STEP(-8,12)
AREA STEP(-16,0):COLOR Mag:AREAFILL
AREA(200,8):AREA STEP(56,0):AREA STEP(0,16)
AREA STEP(-24,0):AREA STEP(0,-4):AREA STEP(-8,0):AREA STEP(0,16)
AREA STEP(8,0):AREA STEP(0,-4):AREA STEP(24,0):AREA STEP(0,16)
AREA STEP(-56,0):COLOR Yel:AREAFILL
COLOR Blu,Blk:LOCATE 24,7
PRINT"Bryan D. Catley 2221 Glasgow Road Alexandria Virginia 22307-1819";
END SUB
SUB BldGadgets (Num,t1(),t2$()) STATIC
FOR n=0 TO Num-1
FOR m=0 TO 6
READ t1(n,m)
NEXT m
READ t2$(n)
NEXT n
END SUB
SUB DrawGadgets (Ga%,Gb%,t1(),t2$()) STATIC
FOR n=Ga% TO Gb%
x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
LINE(x1,y1)-(x2,y2),bg,bf:LINE(x1,y1)-(x2,y2),fg,B
IF bo>-1 THEN
LINE(x1+2,y1+2)-(x2-2,y2-2),fg,B
LINE(x2+1,y1+1)-(x2+1,y2+1),bo
LINE(x2+1,y2+1)-(x1+1,y2+1),bo
COLOR fg,bg:row%=INT(y1/8+2):col%=INT(x1/8+2)
LOCATE row%,col%:PRINT t2$(n)
END IF
NEXT n
END SUB
SUB GetGadget (Ga%,Gb%,t1(),t2$(),type) STATIC
SHARED MouseX%,mouseY%,MouseInd
WHILE MOUSE(0)=0:WEND
r%=CSRLIN:c%=POS(0)
mx=MOUSE(1):my=MOUSE(2)
MouseX%=mx:mouseY%=my:MouseInd=0
FOR n=Ga% TO Gb%
IF mx>t1(n,0) AND mx<t1(n,0)+t1(n,2) THEN
IF my>t1(n,1) AND my<t1(n,1)+t1(n,3) THEN
bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
IF bo>-1 THEN
x1=t1(n,0)+2:y1=t1(n,1)+2
x2=x1+t1(n,2)-4:y2=y1+t1(n,3)-4
LINE(x1,y1)-(x2,y2),fg,bf
COLOR bg,fg:row%=INT(y1/8+2):col%=INT(x1/8+2)
LOCATE row%,col%:PRINT t2$(n)
ELSE
IF bo=-1 THEN
x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
LINE(x1,y1)-(x2,y2),fg,bf:LINE(x1,y1)-(x2,y2),bg,B
END IF
END IF
type=n-Ga%+1:n=Gb%:MouseInd=1
IF bo<-1 THEN
n%=type+Ga%-1:DrawGadgets n%,n%,t1(),t2$()
END IF
END IF
END IF
NEXT n
WHILE MOUSE(0)<>0:WEND
LOCATE r%,c%
END SUB